home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / aie8911.zip / FRAME.ARI < prev    next >
Text File  |  1989-08-27  |  31KB  |  888 lines
  1.  
  2. %%%%%%%%%%%%%% auto generated declarations end here %%%%%%%%%%%%%%%%%%%
  3.  
  4. :- module  frame.
  5.  
  6. /*--------------------------------------------------------------------------*/
  7. /*-            FRAME LIBRARY                                               -*/
  8. /*--------------------------------------------------------------------------*/
  9.  
  10. /*              by Chris Jay
  11.                    Instant Recall
  12.                    5900 Walton Rd.
  13.                    Bethesda, Md. 20817
  14.                    (301) 530-0898
  15.  
  16.     This is a library of Prolog predicates for FRAMES.
  17.     It is written in Arity Prolog, but uses few if any
  18.     nonstandard features.
  19.  
  20.     For a discussion of frames in Prolog, see Chris Jay's
  21.     "Expert's Toolbox" column in AI Expert Magazine.
  22.  
  23.     Instant Recall is the publisher of Prolog Tools, a source
  24.     code library for Prolog programmers.  Instant Recall also
  25.     develops custom applications in Prolog.
  26.  
  27. */
  28.  
  29.  
  30. /*--------------------------------------------------------------------------*/
  31. /*-            COMPILER DECLARATIONS                                       -*/
  32. /*--------------------------------------------------------------------------*/
  33. /*
  34.  
  35.              GENERAL DOCUMENTATION
  36.  
  37. TYPED AND UNTYED FRAMES
  38.  
  39. A typed frame is of the form
  40.  
  41.     TYPE( SLOT_LIST).
  42.  
  43. An untyped frame is of the form
  44.  
  45.        SLOT_LIST.
  46.  
  47. The predicates in this module are designed to work
  48. whether you pass them typed or untyped frames.
  49.  
  50. */
  51. /*
  52. :- module frame.
  53.  
  54. :- public
  55.          test / 0                          ,
  56.          add_slot / 4                      ,
  57.          frame_slot_val / 3                ,
  58.          test_display / 0                  ,
  59.          slot_intersect / 1                ,
  60.          slot_intersect_with_unify / 1     ,
  61.          field_display / 2                 ,
  62.          frame_intersect_with_unify / 3    ,
  63.          slot_display / 2                  ,
  64.          slot_unify / 1                    ,
  65.          update_frame_slot_val / 4         .
  66.  
  67. :- visible
  68.          test / 0                          ,
  69.          add_slot / 4                      ,
  70.          frame_slot_val / 3                ,
  71.          test_display / 0                  ,
  72.          slot_intersect / 1                ,
  73.          slot_intersect_with_unify / 1     ,
  74.          field_display / 2                 ,
  75.          frame_intersect_with_unify / 3    ,
  76.          slot_display / 2                  ,
  77.          slot_unify / 1                    .
  78.  
  79.  
  80.  
  81. :- extrn trace_message / 1.
  82.  
  83. */
  84. /*--------------------------------------------------------------------------*/
  85. /*-            EXAMPLES OF FRAMES                                          -*/
  86. /*--------------------------------------------------------------------------*/
  87. /* Here are some examples of frames, which illustrate the syntax of frames,
  88.    and how they can be used to describe a complex object.
  89. */
  90.  
  91. %             /*  This is a sample frame         */
  92. %             /*  describing a resistor          */
  93. % part([part_number : r0505x,
  94. %       class : resistor,
  95. %       value  : ohms(1000),
  96. %       rating : watts(0.5),
  97. %       tolerance : percent(5)]).
  98. %
  99. %             /*  Sample frame describing a      */
  100. %             /*  capacitor                      */
  101. % part([part_number : c10elx,
  102. %       class : capacitor,
  103. %       subclass : electrolytic,
  104. %       value  : microfarads(100),
  105. %       rating : voltage(125),
  106. %       tolerance : percent(10)]).
  107. %
  108. %
  109. %                    /*  This sample frame              */
  110. %                    /*  partially describes an I.C.    */
  111. % part([part_number : lm309,
  112. %       class : ic,
  113. %       device : set([op_amp]),
  114. %       devices_on_chip : 4,               /*  Number of op amps on the chip  */
  115. %       pins : 16,                         /*  Number of pins                 */
  116. %
  117. %                                          /*  Subframes describing each pin: */
  118. %
  119. %       pin(1): pin([type : set([voltage_supply, positive]),
  120. %                    milliamps : [60, 120],
  121. %                    volts : [9, 14]
  122. %                    ]),
  123. %       pin(2): pin([type : set([voltage_supply, negative]),
  124. %                    milliamps : [60, 120],
  125. %                    volts : [-9, -14]
  126. %                    ]),
  127. %       pin(3): pin([device_number : 1,    /*  Number of the op amp to which  */
  128. %                                          /*  this pin applies               */
  129. %                    type : set([input, inverting]),
  130. %                    volts : [-3, 3],
  131. %                    milliamps : [0, 10]
  132. %                    ]),
  133. %       pin(4): pin([device_number : 1,
  134. %                    type : set([input, non_inverting]),
  135. %                    volts : [-3, 3],
  136. %                    milliamps : [0, 10]
  137. %                    ]),
  138. %       pin(5): pin([device_number : 1,
  139. %                    type : set([output]),
  140. %                    milliamps : [0, 100],
  141. %                    volts : [-7, 7]
  142. %                    ])
  143. %                                          /*  The rest of the pins aren't    */
  144. %                                          /*  yet described.                 */
  145. %       ]).
  146.  
  147.  
  148. /*--------------------------------------------------------------------------*/
  149. /*-            FRAME HANDLING UTILITIES                                    -*/
  150. /*--------------------------------------------------------------------------*/
  151.  
  152. /*-------------------- is_frame  -------------------------------------------*/
  153.  
  154. /* This is true if its arg. is a frame, and false otherwise.  */
  155.  
  156. is_frame( Term    )   :-
  157.          is_typed_frame( Term).
  158.  
  159. is_frame( Term    )   :-
  160.            is_slot_list( Term ).
  161.  
  162. /*-------------------- is_typed_frame  -------------------------------------*/
  163.  
  164. /* This is true if its arg. is a typed frame, and false otherwise.  */
  165.  
  166. is_typed_frame( Term    )   :-
  167.                  % make sure arity is 1
  168.            functor( Term, _, 1),
  169.            arg( 1, Term, X) ,
  170.            is_slot_list(X).
  171.  
  172.  
  173. /*-------------------- is_slot_list ----------------------------------------*/
  174.  
  175. /* This predicate succeeds when its argument is a frame slot list.
  176. */
  177.  
  178.  
  179. is_slot_list(  X ) :- var(X), !, fail.
  180. is_slot_list( [ _ : _ | X]) :-
  181.           is_slot_list_hlpr(X).
  182.  
  183. is_slot_list_hlpr([]):-!.
  184. is_slot_list_hlpr(X):- is_slot_list(X).
  185.  
  186. /*-------------------- frame_info ------------------------------------------*/
  187.  
  188. /* frame_info finds the class name and slot list of a frame,
  189.          given the frame itself.  (The slot list is a list of
  190.          <slot_name : slot_value>  pairs
  191. */
  192.  
  193. frame_info(Frame, Class_name, Slot_list):-
  194.     is_typed_frame( Frame ),
  195.         % then find its functor and argument
  196.     Frame =.. [Class_name, Slot_list].
  197.  
  198.  
  199. frame_info(Frame, untyped, Frame    ):-
  200.            is_slot_list( Frame     ).
  201.  
  202.  
  203.  
  204. /*-------------------- frame_slots -----------------------------------------*/
  205.  
  206. /* frame_slots  returns the list of slots in a frame.        */
  207.  
  208. frame_slots( Frame, Slots  ) :-
  209.        frame_info( Frame, _ ,  Slot_list ),
  210.        frame_slots_hlpr( Slot_list, Slots ).
  211.  
  212. frame_slots_hlpr( [ ] , [ ] ) :- !.
  213. frame_slots_hlpr( [S : _ | T ] , [ S | T1 ] ) :-
  214.       frame_slots_hlpr( T  ,  T1  ).
  215.  
  216. /*-------------------- build_untyped_frame ---------------------------------*/
  217.  
  218. /* build_untyped_frame builds a slot list give a list of slots and a list of
  219.    values.  It pairs correspondng list elements.  when it runs out of
  220.    either slots or values, it quits, returning the pairs built.
  221.  
  222.    Examples
  223.  
  224.       Call :  build_untyped_frame( [ 1, 2, 3],  [ a, b, c], X ).
  225.       Return : X = [ 1 : a, 2 : b, 3 : c ]
  226.  
  227.       Call :  build_untyped_frame( [ 1, 2 ],  [ a, b, c], X ).
  228.       Return : X = [ 1 : a, 2 : b  ]
  229.  
  230. */
  231.  
  232. build_untyped_frame( [] , _, [] ) :- !.
  233.  
  234. build_untyped_frame( _, [] , [] ) :- !.
  235.  
  236. build_untyped_frame( [ Slot | Slots ] ,
  237.                  [ Val  |  Vals ] ,
  238.                  [ Slot : Val | Rest ] ) :-
  239.            build_untyped_frame( Slots, Vals, Rest).
  240.  
  241. /*-------------------- frame_slot_val --------------------------------------*/
  242.  
  243. /* frame_slot_val extracts the value of the slot named Tag from frame Frame.
  244.    It fails if the value is not there.
  245. */
  246. frame_slot_val(Tag, Frame, Slot_val):-
  247.            % get slot list
  248.     frame_info(Frame, _, Slot_list),
  249.            % get value of Tag
  250.     slot_list_val(Tag, Slot_list, Slot_val).
  251.  
  252.            % get value when list starts with slot having Tag
  253. slot_list_val(Tag, [Tag : Slot_val | _], Slot_val):- !.
  254.  
  255.            % recurse
  256. slot_list_val(Tag, [_ : _ | Slot_list], Slot_val):-
  257.     slot_list_val(Tag, Slot_list, Slot_val).
  258.  
  259. /*------------ update_frame_slot_val --------------------------------------*/
  260.  
  261. /* updates the value of a slot in a frame, adding slot if it is not there. */
  262.  
  263. update_frame_slot_val( Tag, New_val, Old_frame, New_frame) :-
  264.         frame_info( Old_frame, Class_name, Old_slots),
  265.         update_frame_slot_val_hlpr(  Tag, New_val, Old_slots, New_slots),
  266.         (    Class_name == untyped,
  267.              !,
  268.              New_frame = New_slots
  269.           ;  New_frame =..[ Class_name, New_slots]).
  270.  
  271. update_frame_slot_val_hlpr( Tag, New_value, [], [ Tag : New_value] ) :- !.
  272. update_frame_slot_val_hlpr( Tag,
  273.                             New_value,
  274.                             [ Tag : _ | Rest ],
  275.                             [ Tag : New_value | Rest ] ) :- !.
  276. update_frame_slot_val_hlpr( Tag,
  277.                             New_value,
  278.                             [ Pair  | Rest ],
  279.                             [ Pair  | Rest2  ] ) :-
  280.            update_frame_slot_val_hlpr( Tag,
  281.                                        New_value,
  282.                                        Rest,
  283.                                        Rest2  ).
  284.  
  285. /*-------------------- frame_slot_val_with_default -------------------------*/
  286.  
  287. /* frame_slot_val extracts the value of the slot named Tag from frame Frame.
  288.    It fails if the value is not there.
  289. */
  290.  
  291. frame_slot_val_with_default(Tag, Frame, Default, Slot_val):-
  292.            % get slot list
  293.     frame_info(Frame, _, Slot_list),
  294.            % get value of Tag
  295.     slot_list_val(Tag, Slot_list, Default, Slot_val).
  296.  
  297.            % default when there is no more pairs in slot list
  298. slot_list_val( _, [], Default, Default ):- !.
  299.  
  300.            % get value when list starts with slot having Tag
  301. slot_list_val(Tag, [Tag : Slot_val | _], _ , Slot_val):- !.
  302.  
  303.            % recurse
  304. slot_list_val(Tag, [_ : _ | Slot_list], Default, Slot_val):-
  305.     slot_list_val(Tag, Slot_list, Default, Slot_val).
  306.  
  307. /*-------------------- frame_map -------------------------------------------*/
  308.  
  309. /* frame_map applies Goal to each  Tag : Slot_val pair in Frame.
  310.  
  311.    Here Goal is a Prolog goal with an implicit Tag : Slot_val first
  312.    argument (in the same way that DCGs suppress the input and left-over
  313.    variables of grammar terms).
  314.  
  315.    For example, to write the fields of Frame starting at col. N, we
  316.    could call
  317.  
  318.    frame_map(Frame, field_display( N ))
  319.  
  320.    where   field_display is defined like this:
  321.  
  322.    field_display( Tag : Slot_val, N ):-
  323.         logt_tab(N),
  324.         log_write(Tag),
  325.         log_write($ : $),
  326.         log_write( Slot_val),
  327.         log_nl.
  328. */
  329.  
  330.  
  331.  
  332. frame_map(Frame, Predicate):-
  333.               % get slot list
  334.     frame_info(Frame, _, Slot_list),
  335.               % map it
  336.     slot_list_map(Slot_list, Predicate).
  337.  
  338. slot_list_map([Tag : Slot_val | Slot_list], Predicate):-
  339.                                /*  Call Predicate with            */
  340.                                /*  Tag:Slot_val as its 1st arg.;  */
  341.                                /*  append other arg.'s passed:    */
  342.     make_call_term(Predicate, Tag : Slot_val, Term),
  343.     call(Term),
  344.     !,
  345.     slot_list_map(Slot_list, Predicate).  % recurse
  346. slot_list_map([], _).
  347.  
  348. /*-------------------- frame_display ---------------------------------------*/
  349.  
  350. /*  frame_display 'pretty print's a frame
  351. */
  352.  
  353.  
  354. frame_display(Frame):-
  355.     is_frame( Frame ),
  356.     frame_display0(Frame, 0).
  357.  
  358. frame_display0(Frame, Start_col):-
  359.     frame_info(Frame, Frame_name, _),
  360.     log_nl,
  361.     log_tab(Start_col),
  362.     log_write('FRAME '),
  363.     log_write(Frame_name),
  364.  
  365.     frame_map(Frame, slot_display(Start_col)),
  366.  
  367.     log_nl,
  368.     log_tab(Start_col),
  369.     log_write('END_FRAME'),
  370.     !.
  371. frame_display0(Frame, _):-
  372.     log_nl,
  373.     log_write('Syntactically invalid frame:'),
  374.     log_nl,
  375.     log_write(Frame).
  376.  
  377. slot_display(Tag : Slot_val, Start_col):-
  378.     log_nl,
  379.     log_tab(Start_col),
  380.     slot_display0(Tag : Slot_val, Start_col).
  381.  
  382. slot_display0(Tag : Slot_val, Start_col):-
  383.     is_frame( Slot_val ),
  384.     !,
  385.     log_write(Tag),
  386.     log_write(' :'),
  387.     New_start_col is Start_col + 3,
  388.     frame_display0(Slot_val, New_start_col).
  389. slot_display0(Tag : Slot_val, _):-
  390.     log_write(Tag : Slot_val).
  391.  
  392. /*-------------------- slot_remove  ----------------------------------------*/
  393.  
  394. /* slot_remove(Tag,
  395.                Old_slot_list,
  396.                New_slot_list)
  397.  
  398.    removes the slot with Tag from Old_slot_list.
  399.    Puts resulting slot list in New_slot_list.
  400.    Puts value of Tag in Slot_val.
  401.    FAILS if Tag is not a tag in Old_slot_list.
  402. */
  403.  
  404. slot_remove( Tag,  Old_frame, New_frame) :-
  405.         frame_info( Old_frame, Class_name, Old_slots),
  406.         slot_remove_hlpr(  Tag,  Old_slots, New_slots),
  407.         (    Class_name == untyped,
  408.              !,
  409.              New_frame = New_slots
  410.           ;  New_frame =..[ Class_name, New_slots]).
  411.  
  412.  
  413. slot_remove_hlpr(Tag,  [Tag : _ | Slot_list], Slot_list):-
  414.     !.
  415. slot_remove_hlpr(Tag,
  416.            [Tag1 : Slot_val1 | Slot_list],
  417.            [Tag1 : Slot_val1 | New_slot_list]):-
  418.     slot_remove_hlpr(Tag,  Slot_list, New_slot_list).
  419.  
  420.  
  421. /*-------------------- remove_if_slot --------------------------------------*/
  422.  
  423. /* remove_if_slot(Tag,
  424.                   Slot_list,
  425.                   New_slot_list)
  426.  
  427.    removes the slot with Tag from Slot_list if such a slot exists.
  428.    Puts resulting slot list in New_slot_list.
  429.    New_slot_list = Slot_list when no slot has Tag.
  430.    Always succeeds.
  431. */
  432.  
  433.  
  434. remove_if_slot(Tag, Slot_list, New_slot_list):-
  435.     slot_remove(Tag,    Slot_list, New_slot_list),
  436.     !.
  437. remove_if_slot(_, Slot_list, Slot_list).
  438.  
  439.  
  440. /*-------------------- frame_merge  ----------------------------------------*/
  441.  
  442. /*  frame_merge(Frame1,
  443.                 Frame2,
  444.                 New_frame,
  445.                 Slot_merge_pred,
  446.                 Slot_append_pred),
  447.  
  448.      merges Frame1 and Frame2 into New_frame, where Slot_merge_pred
  449.      is used to create the output slot.
  450.  
  451.  
  452. */
  453.  
  454.  
  455. frame_merge(Frame1, Frame2, New_frame, Slot_merge_pred):-
  456.                                          /*  2 frames must have same name:  */
  457.     frame_info(Frame1, Class_name, Slot_list1),
  458.     frame_info(Frame2, Class_name, Slot_list2),
  459.                                          /*  Merge the tag/slot lists:      */
  460.     slot_list_merge(Slot_list1, Slot_list2, New_slot_list, Slot_merge_pred),
  461.                                          /*  Construct the new frame:       */
  462.     New_frame =.. [Class_name, New_slot_list],
  463.     !.
  464.  
  465.  
  466. /*-------------------- slot_list_merge -------------------------------------*/
  467.  
  468. /* slot_list_merge( Slot_list1,
  469.                     Slot_list2,
  470.                     New_slot_list,
  471.                     Slot_merge_pred  )
  472.  
  473.    merges a pair of slot lists, where Slot_merge_pred is used to
  474.    merge the individual slots.
  475.  
  476.  
  477.  
  478. */
  479.  
  480.      %  Terminate the recursion when both input lists are empty
  481. slot_list_merge( [],
  482.                  [],
  483.                  [],
  484.                  _  )  :- !.
  485.  
  486.      % If both frames contain a slot with Tag, then use Slot_merge_pred
  487.      % to unify them.  Make slot_list_merge fail if Slot_merge_pred
  488.      % sets FailFlag to fail.  This lets us distinguish between
  489.      % two slot values failing to merge but wanting to go on, and
  490.      % wanting to quit when merge fails on the slot values.
  491.      %
  492.      % In particular, Slot_merge_pred's behavior is related to what
  493.      % slot_list_merge should do in the following way:
  494.      %
  495.      %  What slot_list_merge does    What Slot_merge_pred does
  496.      %  when slot values fail to     when slot values fail to
  497.      %  merge                        merge
  498.      %
  499.      %  fail                         set  FailFlag to fail and succeed
  500.      %
  501.      %  leave out the slot           fail
  502.      %
  503.  
  504. slot_list_merge( [Tag : Slot_val1 | Slot_list1],
  505.                  Slot_list2,
  506.                  [Tag : New_slot_val | New_slot_list],
  507.                  Slot_merge_pred):-
  508.                     % create a term which will try to merge the
  509.                     % slot with Tag in the slot list in arg. 1, with
  510.                     % some frame in the slot list in arg. 2
  511.     make_call_term(Slot_merge_pred,
  512.                    [Tag : Slot_val1, Slot_list2, New_slot_val, FailFlag],
  513.                    Term),
  514.     call(Term),     % call that term
  515.     !,
  516.                     % cut, fail if FailFlag == fail
  517.     FailFlag \== fail,
  518.                     % remove the slot that merges from the 2nd. slot list
  519.     remove_if_slot(Tag, Slot_list2, New_slot_list2),
  520.                     % recurse
  521.     slot_list_merge(Slot_list1,
  522.                     New_slot_list2,
  523.                     New_slot_list,
  524.                     Slot_merge_pred).
  525.  
  526.      % Skip Tag:Slot_val1 if Slot_merge_pred failed.
  527. slot_list_merge([_ | Slot_list1],
  528.                Slot_list2,
  529.                New_slot_list,
  530.                Slot_merge_pred):-
  531.     slot_list_merge(Slot_list1,
  532.                     Slot_list2,
  533.                     New_slot_list,
  534.                     Slot_merge_pred).
  535.  
  536.      % When the first slot list is exhausted, switch the slot list
  537.      % arguments, and recurse.
  538. slot_list_merge([],
  539.                 [Slot | Slot_list],
  540.                 New_slot_list,
  541.                 Slot_merge_pred):-
  542.     slot_list_merge([Slot | Slot_list],
  543.                     [],
  544.                     New_slot_list,
  545.                     Slot_merge_pred).
  546.  
  547.  
  548. /*-------------------- frame_unify -----------------------------------------*/
  549.  
  550. /* Unifies two frames.  Slots that are present in one frame and not in
  551.    another are added to the unification, as if the slot had appeared in
  552.    the frame where it was absent with a variable value.
  553. */
  554.  
  555.                     /*  frame_unify                    */
  556. frame_unify(Frame1, Frame2, Unification ):-
  557.              % use frame_merge to implement frame_unify
  558.     frame_merge(Frame1, Frame2, Unification, slot_unify).
  559.  
  560.  
  561.  
  562.    %  slot_unify([Tag : Slot_val1, Slot_list2, Result, Fail_Flag ])
  563.    %
  564.    % unifies a slot with Tag with a member of a Slot_list2 if possible.
  565.  
  566.       % This first rule applies when Slot_list2 contains a slot with Tag.
  567.       % Result is the unification if it exists.
  568.       % Fail_Flag is set to fail if unification fails, to signal
  569.       % frame_merge to fail.
  570. slot_unify([Tag : Slot_val1, Slot_list2, Result, Fail_Flag ]):-
  571.               % get value for Tag
  572.     slot_list_val(Tag, Slot_list2, Slot_val2),
  573.               % If slot list 2 contains a slot with Tag,
  574.               % stay in this rule
  575.     !,
  576.               % if these slot values unify
  577.     (    value_unify(Slot_val1, Slot_val2, Result),
  578.               % then stay in this alternative
  579.          !,
  580.               % and tell frame_merge not to fail
  581.          Fail_Flag = true
  582.               % if the slot values do not unify
  583.               % tell frame_merge to fail
  584.       ;  Fail_Flag = fail ).
  585.  
  586.        % When the slot in arg. 1 does not appear in the
  587.        % arg. 2 slot list, the result of unify is the slot
  588.        % value in arg. 1
  589. slot_unify([ _  : Slot_val1, _ , Slot_val1 , _]):-  !.
  590.  
  591.  
  592. /*-------------------- value_unify -----------------------------------------*/
  593.  
  594.       % value_unify unifies slot values
  595.       % Arg 3 is the unification
  596.             % this rule unifies those things that are not frames
  597. value_unify(Slot_val1, Slot_val2,  Slot_val1):-
  598.              Slot_val1 = Slot_val2, !.
  599.  
  600.             % this rule unifies  frames
  601. value_unify(Slot_val1, Slot_val2, Result ):-
  602.     frame_merge(Slot_val1, Slot_val2, Result, slot_unify),
  603.     !.
  604.  
  605.            % set unify slot values that are sets
  606. value_unify(Slot_val1, Slot_val2, Slot_val1) :-
  607.     set_unify(  Slot_val1, Slot_val2  ) ,!.
  608.  
  609. /*-------------------- add_slot --------------------------------------------*/
  610.  
  611. /*
  612.    add_slot( Old_frame, Slot, Value, New_frame)
  613.  
  614.    adds [ Slot : Value ] to Old_frame, provided that the new Value of Slot
  615.    unifies with any existing value in Old_frame
  616. */
  617.  
  618. add_slot( Old_frame, Slot, Value, New_frame) :-
  619.         frame_unify(Old_frame, [ Slot : Value], New_frame ).
  620.  
  621. /*-------------------- frame_intersect -------------------------------------*/
  622.  
  623. /* frame_intersect creates a new frame from 2 existing frames by
  624.     * keeping in slots that appear in both frames with values that unify,
  625.       and letting the value of such slots be the unification of the input
  626.       slot values
  627.     * deleting all other slots, including those where the same tag has
  628.       values in the two frames that don't unify.
  629. */
  630.  
  631. frame_intersect(Frame1, Frame2, Intersection ):-
  632.            % do this with frame_merge
  633.     frame_merge(Frame1, Frame2, Intersection, slot_intersect).
  634.  
  635. slot_intersect([Tag : Slot_val1, Slot_list2, New_slot_val, true    ]):-
  636.     slot_list_val(Tag, Slot_list2, Slot_val2), !,
  637.            % merge slot values
  638.     slot_merge0(Slot_val1, Slot_val2, New_slot_val, _  ).
  639.  
  640.            % note that when a slot with Tag is not in Slot_list2,
  641.            % slot_intersect fails.  This causes frame_merge to
  642.            % leave the Tag slot out of the computed Intersection
  643.  
  644.            % unify slots if possible
  645. slot_merge0(Slot_val1, Slot_val2, Slot_val1, _):-
  646.              Slot_val1 = Slot_val2, !.
  647.  
  648.            % intersect slot values that are frames
  649. slot_merge0(Slot_val1, Slot_val2, New_slot_val, _):-
  650.     frame_merge(Slot_val1, Slot_val2, New_slot_val, slot_intersect),
  651.     !.
  652.  
  653.            % set unify slot values that are sets
  654. slot_merge0(Slot_val1, Slot_val2, Slot_val1   , _):-
  655.     set_unify(  Slot_val1, Slot_val2  ) ,!.
  656.  
  657.  
  658. /*-------------------- frame_intersect_with_unify --------------------------*/
  659.  
  660. /* This is similar to frame_intersect, except that if a tag appears in
  661.    both frames, the values must unify.  Note that the predicate differs
  662.    only in the use of the fail flag in frame_merge.  In frame_intersect
  663.    we let slot unification fail without telling frame_intersect.  Here
  664.    we use the fail flag to tell frame_intersect_with_unify  to fail.
  665. */
  666.  
  667.  
  668. frame_intersect_with_unify(Frame1, Frame2, Intersection ):-
  669.     frame_merge(Frame1, Frame2, Intersection, slot_intersect_with_unify).
  670.  
  671.            % This rule is for when the slot with Tag is in Slot_list2
  672.            % It sets FailFlag according to whether unification succeeds
  673. slot_intersect_with_unify([Tag : Slot_val1,
  674.                            Slot_list2,
  675.                            New_slot_val,
  676.                            FailFlag ]):-
  677.     slot_list_val(Tag, Slot_list2, Slot_val2), !,
  678.     slot_merge2(Slot_val1, Slot_val2, New_slot_val, FailFlag  ).
  679.  
  680. /*
  681.            % This rule is for when the slot with Tag is not in Slot_list2.
  682.            % It sets FailFlag to true, to tell frame_merge not to fail.
  683. slot_intersect_with_unify( _, _, _, true) :-!.
  684. */
  685.  
  686.             % unify slot values if possible
  687. slot_merge2(Slot_val1, Slot_val2, Slot_val1, true):-
  688.              Slot_val1 = Slot_val2, !.
  689.  
  690.             % or frame intersect_with_unify them
  691. slot_merge2(Slot_val1, Slot_val2, New_slot_val, true ):-
  692.     frame_merge(Slot_val1,
  693.                 Slot_val2,
  694.                 New_slot_val,
  695.                 slot_intersect_with_unify),
  696.     !.
  697.  
  698.            % set unify slot values that are sets
  699. slot_merge2(Slot_val1, Slot_val2, Slot_val1 , true):-
  700.     set_unify(  Slot_val1, Slot_val2  ) ,!.
  701.  
  702.  
  703.  
  704.             % but tell frame_merge to fail when you can't
  705. slot_merge2( _, _ , _, fail):-  !.
  706.  
  707.  
  708.  
  709. /*--------------------------------------------------------------------------*/
  710. /*-            UTILITY PREDICATES                                          -*/
  711. /*--------------------------------------------------------------------------*/
  712.  
  713. make_call_term(Predicate, First_arg, Call_term):-
  714.                                          /*  Make term by adding First_arg  */
  715.                                          /*  as first argument of Predicate */
  716.                                          /*  (other arguments appended)     */
  717.     Predicate =.. [Pred_name | Args],
  718.     Call_term =.. [Pred_name, First_arg | Args].
  719.  
  720.                                          /*  Remove E from list:            */
  721. member_remove(E, [E | T], T):-
  722.     !.
  723. member_remove(E, [H | T], [H | L]):-
  724.     member_remove(E, T, L).
  725.                                          /*  Remove E from list, always     */
  726.                                          /*  succeed:                       */
  727. remove_if_member(E, L, NewL):-
  728.     member_remove(E, L, NewL),
  729.     !.
  730. remove_if_member(_, L, L).
  731.  
  732.  
  733.                                          /*  Set handling predicates:       */
  734. set_unify(set([H | T]), set(L2)):-
  735.     member_remove(H, L2, NewL2),
  736.     set_unify(set(T), set(NewL2)).
  737. set_unify(set([]), set([])).
  738.  
  739.  
  740.  
  741. /*--------------------------------------------------------------------------*/
  742. /*-            TEST PREDICATES                                             -*/
  743. /*--------------------------------------------------------------------------*/
  744. /*
  745. trace_message(X) :-  var(X), !, write(X), nl.
  746. trace_message([H|T]) :- !, writeq(H),  trace_message(T).
  747. trace_message([])    :- nl,!.
  748. trace_message(X) :-  trace_message([X]),!.
  749. */
  750.  
  751. % f(part(X)):- part(X).                  /*  Include part frames in test    */
  752.  
  753.  
  754. % test_display:-                           /*  test frame_display             */
  755. %     f(Frame),
  756. %     frame_display(Frame),
  757. %     fail.
  758. % test_display.
  759.  
  760.  
  761.  
  762.  
  763. %   test_unify:-
  764. %       New_pin_frame = part([part_number : lm309,
  765. %                           class : ic,
  766. %                                          /*  Append info. to 'type' slot    */
  767. %                                          /*  for pins 3 and 4:              */
  768. %                           pin(3): pin([type : set([high_gain])]),
  769. %                           pin(4): pin([type : set([high_gain])]),
  770. %                                          /*  Add new pin descr. for pin 8:  */
  771. %                           pin(8): pin([device_number : 2,
  772. %                                        type : set([output]),
  773. %                                        milliamps : [0, 100],
  774. %                                        volts : [-7, 7]
  775. %                                       ])
  776. %                          ]),
  777. %       !,
  778. %       f(Frame),
  779. %       frame_unify(Frame,
  780. %                   New_pin_frame,
  781. %                   New_frame),
  782. %       frame_display(New_frame).
  783.  
  784.  
  785. %      % test of frame predicates
  786. % testpred     :-
  787. %    Frame =    part([part_number : r0505x,
  788. %                     class : resistor,
  789. %                     value  : ohms(1000),
  790. %                     rating : watts(0.5),
  791. %                     tolerance : percent(5)]),
  792. %        trace_message([$Frame = $, Frame]),
  793. %        trace_message([$calling frame_info$]),
  794. %    frame_info(Frame, Class_name, Slot_list),
  795. %        trace_message([$Class_name = $, Class_name]),
  796. %        trace_message([$Slot_list = $, Slot_list ]),
  797. %        trace_message([$calling frame_map$]),
  798. %    frame_map(Frame, field_display( 10)),
  799. %        trace_message([$calling frame_display:$]),
  800. %    frame_display(Frame),
  801. %        trace_message([$calling slot_remove:$]),
  802. %    slot_remove(value,
  803. %                Slot_list,
  804. %                New_slot_list),
  805. %        trace_message([$Slot_val = $, Slot_val]),
  806. %        trace_message([$New_slot_list = $, New_slot_list ]),
  807. %        trace_message([$calling remove_if_slot, Tag = foo:$]),
  808. %    remove_if_slot(foo,
  809. %                   Slot_list,
  810. %                   New_slot_list2),
  811. %        trace_message([$New_slot_list2 = $, New_slot_list2 ]),
  812. %    Frame1 =    part([part_number : X,
  813. %                      class : resistor,
  814. %                      value  : ohms(1000),
  815. %                      rating : watts(Y),
  816. %                      tolerance : percent(5)]),
  817. %    Frame2 =    part([part_number : 222,
  818. %                      class  : Z,
  819. %                      value  : ohms(W),
  820. %                      rating : watts(5),
  821. %                      tolerance2 : percent(5)]),
  822. %        trace_message([$calling frame_unify Frame1 = $]),
  823. %        frame_display( Frame1 ),
  824. %        trace_message([$calling frame_unify Frame2 = $]),
  825. %        frame_display( Frame2 ),
  826. %    frame_unify(Frame1, Frame2, Unify  ),
  827. %        trace_message([$Unify  = $]),
  828. %        frame_display( Unify  ),
  829. %        trace_message([$calling frame_intersect $]),
  830. %    frame_intersect(Frame1, Frame2, Intersect  ),
  831. %        trace_message([$Intersect = $, Intersect]),
  832. %    Frame1a =    part([part_number : XX,
  833. %                       class : resistor,
  834. %                       value  : ohms(1000),
  835. %                       rating : watts(YY),
  836. %                       tolerance : percent(5)]),
  837. %    Frame2a  =    part([part_number : 222,
  838. %                      class  : Z,
  839. %                      value  : ohms(W),
  840. %                      rating : watts(5),
  841. %                      tolerance2 : percent(5)]),
  842. %        trace_message(
  843. %             [$calling frame_intersect_with_unify Frame1a = $]),
  844. %        frame_display( Frame1a  ),
  845. %    frame_intersect_with_unify( Frame1a, Frame2a, U_intersect  ),
  846. %        trace_message([$U_intersect = $]),
  847. %        frame_display( U_intersect  ).
  848.  
  849.  
  850. % test_merge:-
  851. %       New_pin_frame = part([part_number : lm309,
  852. %                           class : ic,
  853. %                                     /*  Append info. to 'type' slot    */
  854. %                                     /*  for pins 3 and 4:              */
  855. %                           pin(3): pin([type : set([high_gain])]),
  856. %                           pin(4): pin([type : set([high_gain])]),
  857. %                                     /*  Add new pin descr. for pin 8:  */
  858. %                           pin(8): pin([device_number : 2,
  859. %                                        type : set([output]),
  860. %                                        milliamps : [0, 100],
  861. %                                        volts : [-7, 7]
  862. %                                       ])
  863. %                          ]),
  864. %       !,
  865. %       f(Frame),
  866. %       frame_unify( Frame,
  867. %                    New_pin_frame,
  868. %                    New_frame),
  869. %       frame_display(New_frame).
  870.  
  871.  
  872.  
  873. % disktest :-
  874. %     stdout( testfile, testpred).
  875. %
  876. %            % used in test
  877. % field_display( Tag : Slot_val, N ):-
  878. %      tab(N),
  879. %      write(Tag),
  880. %      write($ : $),
  881. %      write( Slot_val),
  882. %      nl.
  883.  
  884.  
  885. /*--------------------------------------------------------------------------*/
  886. /*-            END OF LISTING                                              -*/
  887. /*--------------------------------------------------------------------------*/
  888.